home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / Marlais 0.5.9-portable sources / macintosh.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  6.8 KB  |  271 lines  |  [TEXT/ttxt]
  1. /*
  2.  
  3.    macintosh.c
  4.  
  5.    This software is free software; you can redistribute it and/or
  6.    modify it under the terms of the GNU Library General Public
  7.    License as published by the Free Software Foundation; either
  8.    version 2 of the License, or (at your option) any later version.
  9.  
  10.    This software is distributed in the hope that it will be useful,
  11.    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13.    Library General Public License for more details.
  14.  
  15.    You should have received a copy of the GNU Library General Public
  16.    License along with this software; if not, write to the Free
  17.    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19.    Original copyright notice follows:
  20.  
  21.    Dylan primitives for Macintosh.
  22.  
  23.    Copyright (C) 1994, Patrick C. Beard.  All Rights Reserved.
  24.  
  25.    Permission to use, copy, and modify this software and its
  26.    documentation is hereby granted only under the following terms and
  27.    conditions.  Both the above copyright notice and this permission
  28.    notice must appear in all copies of the software, derivative works
  29.    or modified version, and both notices must appear in supporting
  30.    documentation.  Users of this software agree to the terms and
  31.    conditions set forth in this notice.
  32.  
  33.  */
  34.  
  35. #include "macintosh.h"
  36. #include "string.h"
  37. #include "number.h"
  38. #include "values.h"
  39. #include "error.h"
  40. #include "foreign_ptr.h"
  41.  
  42. #include <StandardFile.h>
  43. #include <Strings.h>
  44. #include <string.h>
  45. #include <Files.h>
  46.  
  47. static Object beep (void);
  48. static Object new_menu (Object title, Object id, Object items);
  49. static Object dispose_menu (Object menu);
  50. static Object insert_menu (Object menu);
  51. static Object delete_menu (Object menu);
  52. static Object draw_menus ();
  53.  
  54. static struct primitive mac_prims[] =
  55. {
  56.     {"beep", prim_0, beep},
  57.     {"get-file", prim_0, get_file},
  58.     {"put-file", prim_0_2, put_file},
  59.     {"%new-menu", prim_3, new_menu},
  60.     {"%dispose-menu", prim_1, dispose_menu},
  61.     {"%insert-menu", prim_1, insert_menu},
  62.     {"%delete-menu", prim_1, delete_menu},
  63.     {"%draw-menus", prim_0, draw_menus},
  64. };
  65.  
  66. void
  67. init_mac_prims ()
  68. {
  69.     int num = sizeof (mac_prims) / sizeof (struct primitive);
  70.  
  71.     init_prims (num, mac_prims);
  72. }
  73.  
  74. static Object
  75. beep ()
  76. {
  77.     SysBeep (1);
  78.     return unspecified_object;
  79. }
  80.  
  81. Object
  82. get_file ()
  83. {
  84.     StandardFileReply reply;
  85.     SFTypeList types =
  86.     {'TEXT'};
  87.  
  88.     StandardGetFile (nil, 1, types, &reply);
  89.     if (reply.sfGood) {
  90.     char path[256];
  91.  
  92.     return make_byte_string (FSSpecToPath (&reply.sfFile, path));
  93.     }
  94.     return false_object;
  95. }
  96.  
  97. Object
  98. put_file (Object defaultNameObj, Object promptObj)
  99. {
  100.     char defaultName[256], prompt[256];
  101.     StandardFileReply reply;
  102.  
  103.     defaultName[0] = 0;
  104.     if (defaultNameObj != NULL) {
  105.     if (BYTESTRP (defaultNameObj))
  106.         strcpy (defaultName, BYTESTRVAL (defaultNameObj));
  107.     else
  108.         error ("put-file: default name should be a <string> not", defaultNameObj, NULL);
  109.     }
  110.     prompt[0] = 0;
  111.     if (promptObj != NULL) {
  112.     if (BYTESTRP (promptObj))
  113.         strcpy (prompt, BYTESTRVAL (promptObj));
  114.     else
  115.         error ("put-file: prompt should be a <string> not", promptObj, NULL);
  116.     }
  117.     StandardPutFile (c2pstr (prompt), c2pstr (defaultName), &reply);
  118.     if (reply.sfGood) {
  119.     FSSpec *file = &reply.sfFile;
  120.  
  121.     return make_byte_string (FSSpecToPath (&reply.sfFile, defaultName));
  122.     }
  123.     return false_object;
  124. }
  125.  
  126. static char *
  127. dir_path (char path[256], long dirID, short vRefNum)
  128. {
  129.     static CInfoPBRec info;
  130.     Str32 dirName;
  131.     OSErr result;
  132.  
  133.     info.dirInfo.ioNamePtr = dirName;
  134.     info.dirInfo.ioVRefNum = vRefNum;
  135.     info.dirInfo.ioFDirIndex = -1;
  136.     info.dirInfo.ioDrDirID = dirID;
  137.     result = PBGetCatInfoAsync (&info);
  138.  
  139.     // when we reach the root directory, we terminate the recursion.
  140.     if (dirID == 2)
  141.     return strcat (strcpy (path, p2cstr (dirName)), ":");
  142.     else
  143.     return strcat (strcat (dir_path (path, info.dirInfo.ioDrParID, vRefNum), p2cstr (dirName)), ":");
  144. }
  145.  
  146. char *
  147. FSSpecToPath (FSSpec * file, char path[256])
  148. {
  149.     return strcat (dir_path (path, file->parID, file->vRefNum), p2cstr (file->name));
  150. }
  151.  
  152. /* to make error.c happy. */
  153.  
  154. char *sys_siglist[32] =
  155. {
  156.     "",
  157.     "hangup",
  158.     "interrupt",
  159.     "quit",
  160.     "illegal instruction (not reset when caught)",
  161.     "trace trap (not reset when caught)",
  162.     "IOT instruction",
  163.     "EMT instruction",
  164.     "floating point exception",
  165.     "kill (cannot be caught or ignored)",
  166.     "bus error",
  167.     "segmentation violation",
  168.     "bad argument to system call",
  169.     "write on a pipe with no one to read it",
  170.     "alarm clock",
  171.     "software termination signal from kill",
  172.     "urgent condition on IO channel",
  173.     "sendable stop signal not from tty",
  174.     "stop signal from tty",
  175.     "continue a stopped process",
  176.     "to parent on child stop or exit",
  177.     "to readers pgrp upon background tty read",
  178.     "like TTIN for output if (tp->t_local<OSTOP)",
  179.     "input/output possible signal",
  180.     "exceeded CPU time limit",
  181.     "exceeded file size limit",
  182.     "virtual time alarm",
  183.     "profiling time alarm",
  184.     "window changed",
  185.     "resource lost (eg, record-lock lost)",
  186.     "user defined signal 1",
  187.     "user defined signal 2",
  188. };
  189.  
  190. // menu manager functions.
  191.  
  192. static Object
  193. new_menu (Object title, Object id, Object items)
  194. {
  195.     Str255 str;
  196.     MenuHandle menu;
  197.  
  198.     if (!BYTESTRP (title)) {
  199.     error ("%new-menu: first parameter must be a <string> not ", title, NULL);
  200.     }
  201.     memcpy (str + 1, BYTESTRVAL (title), BYTESTRSIZE (title));
  202.     str[0] = BYTESTRSIZE (title);
  203.  
  204.     menu = NewMenu (INTVAL (id), str);
  205.     if (!menu) {
  206.     error ("%new-menu: NewMenu failed.", NULL);
  207.     }
  208.     // add all items (strings) in the list.
  209.     while (!EMPTYLISTP (items)) {
  210.     Object item = CAR (items);
  211.     int length = BYTESTRSIZE (item);
  212.  
  213.     memcpy (str + 1, BYTESTRVAL (item), length);
  214.     str[0] = length;
  215.     AppendMenu (menu, str);
  216.     items = CDR (items);
  217.     }
  218.  
  219.     // wrap the menu handle in a foreign pointer object.
  220.     return make_foreign_ptr (menu);
  221. }
  222.  
  223. static Object
  224. dispose_menu (Object menuObj)
  225. {
  226.     MenuHandle menu;
  227.  
  228.     if (!FOREIGNP (menuObj)) {
  229.     error ("%dispose-menu: menu not a foreign pointer.", menuObj, NULL);
  230.     }
  231.     menu = (MenuHandle) FOREIGNPTR (menuObj);
  232.     DisposeMenu (menu);
  233.  
  234.     return unspecified_object;
  235. }
  236.  
  237. static Object
  238. insert_menu (Object menuObj)
  239. {
  240.     MenuHandle menu;
  241.  
  242.     if (!FOREIGNP (menuObj)) {
  243.     error ("%insert-menu: menu not a foreign pointer.", menuObj, NULL);
  244.     }
  245.     menu = (MenuHandle) FOREIGNPTR (menuObj);
  246.     InsertMenu (menu, 0);
  247.  
  248.     return unspecified_object;
  249. }
  250.  
  251. static Object
  252. delete_menu (Object menuObj)
  253. {
  254.     MenuHandle menu;
  255.  
  256.     if (!FOREIGNP (menuObj)) {
  257.     error ("%delete-menu: menu not a foreign pointer.", menuObj, NULL);
  258.     }
  259.     menu = (MenuHandle) FOREIGNPTR (menuObj);
  260.     DeleteMenu ((**menu).menuID);
  261.  
  262.     return unspecified_object;
  263. }
  264.  
  265. static Object
  266. draw_menus ()
  267. {
  268.     DrawMenuBar ();
  269.     return unspecified_object;
  270. }
  271.